'##################################################
'###  Top Level (Get root Path from system env)
'##################################################
function GetEnv(envVarName)
	On Error Resume Next
	' 创建Shell对象并获取值
	Set WshShell = CreateObject("WScript.Shell")
	envValue = WshShell.Environment("PROCESS")(envVarName) ' 优先查找进程级变量

	' 如果未找到则尝试系统级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("SYSTEM")(envVarName)
	End If

	' 如果仍未找到则尝试用户级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("USER")(envVarName)
	End If

	' 检查结果并输出
	If Err.Number = 0 And envValue <> "" Then
		GetEnv=envValue
	Else
		GetEnv=""
	End If
end function

'##################################################
'##################################################
'##################################################
sub IncludeVbs(filepath)
	Dim fso, file, content
	Set fso = CreateObject("Scripting.FileSystemObject")
	' 读取functions.vbs的内容
	Set file = fso.OpenTextFile(filepath, 1) ' 1表示只读
	content = file.ReadAll
	file.Close
	' 将functions.vbs的内容载入全局作用域
	ExecuteGlobal content
end sub

'##################################################
'##################################################
'##################################################
dim root,tmpfile
Dim doc
Set doc = application.ActiveDocument
dim msg :msg = "0-clear // 1-Trace&Pad // 2-PadOnly"
dim seltype
dim userLayerName:userLayerName="zyq_chk"
Dim usrLyrObj
main
set doc = nothing
sub main()	
	'// REUSE
	envVarName ="EXP_SHORTCUTS_ROOT"
	root = GetEnv(envVarName)'"C:\MentorGraphics\2005EXP\SDD_HOME\pvtk\env\"
	if root ="" then 
		msgbox "please set env value (EXP_SHORTCUTS_ROOT = ?)"
		exit sub
	end if
	
	call IncludeVbs(root & "\skill_lib.vbs")
	
	If ValidateServer(doc) = 0 Then
	    msgbox "Server validation failed."
	    exit sub
	End If	
	'// todo
	seltype = inputbox(msg,seltype,1)
	doc.currentunit=2 'th
	
	call AddUserLayer(userLayerName)
	select case seltype
		case 0:
			on error resume next
			doc.UserLayerGfxs(, userLayerName).Delete
			doc.UserLayerGfxs(, "zyq_chk_1").Delete
		case 1:
			copyTrace
			copyPin
			copyVia
		case 2:
			copyPin
		case else:
			msgbox "wrong input"
			exit sub
	end select
	msgbox "done"
end sub

sub copyTrace()
	dim fabGfxObj
	dim numPoints,pntsArr
	'// copy trace
	dim pcbtraces,pcbtrace
	dim pcbtracewidth
	set pcbtraces = doc.traces(1)
	for each pcbtrace in pcbtraces
		pcbtracewidth = pcbTrace.Geometry.LineWidth
		pntsArr = pcbTrace.Geometry.pointsarray
		numPoints = UBound(pntsArr, 2) + 1
		set fabGfxObj = doc.PutUserLayerGfx(usrLyrObj,pcbtracewidth,numPoints,pntsArr,False,Nothing,epcbUnitCurrent)
	next
end sub

sub copyPin()
	on error resume next
	dim fabGfxObj
	dim numPoints,pntsArr
	'// copy pstack
	dim pads_pstack,pad_pstack
	dim pinpads,pinpad
	dim pinpo,pinpos
	dim pntArr
	Set pstacks = doc.PadstackObjects(1 or 2,1) '1:pin | 2:via
	for each pstack in pstacks
		selpskt = pstack.CurrentPadstack 
		select case pstack.Type
			' case 2 'via
				' cx = pstack.positionX
				' cy = pstack.positionY
				' cr = (pstack.Extrema.MaxX - pstack.Extrema.MinX)*0.5	
				' pntArr = application.Utility.CreateCircleXYR(cx,cy,cr)
			case 1 'pin
				set pinpads = pstack.pads
				for each pinpad in pinpads
					set pinpos = pinpad.Geometries
					for each pinpo in pinpos
						pntArr = pinpo.PointsArray
						exit for
					next
					exit for
				next
		end select	
		numPoints = UBound(pntArr, 2) + 1		
		set fabGfxObj = doc.PutUserLayerGfx(usrLyrObj,1.0,numPoints,pntArr,true,Nothing,epcbUnitCurrent)
	next
end sub

sub copyVia()
	ON ERROR RESUME NEXT
	dim fabGfxObj
	dim numPoints,pntsArr
	'// copy pstack
	dim pads_pstack,pad_pstack
	dim pinpads,pinpad
	dim pinpo,pinpos
	dim pntArr
	Set pstacks = doc.PadstackObjects(1 or 2,1) '1:pin | 2:via
	for each pstack in pstacks
		selpskt = pstack.CurrentPadstack 
		select case pstack.Type
			case 2 'via
				cx = pstack.positionX
				cy = pstack.positionY
				cr = (pstack.Extrema.MaxX - pstack.Extrema.MinX)*0.5	
				pntArr = application.Utility.CreateCircleXYR(cx,cy,cr)			
		end select	
		numPoints = UBound(pntArr, 2) + 1		
		set fabGfxObj = doc.PutUserLayerGfx(usrLyrObj,1.0,numPoints,pntArr,true,Nothing,epcbUnitCurrent)
	next
end sub

sub AddUserLayer(ulyr)
	Set usrLyrObj = doc.FindUserLayer(ulyr)
	If usrLyrObj Is Nothing Then
		Set usrLyrObj = doc.SetupParameter.PutUserLayer(ulyr)
	End If
	' TOP level
	Dim displCtrlObj
	Set displCtrlObj = doc.ActiveView.DisplayControl
	Dim dispCtrlGlobalObj
	Set dispCtrlGlobalObj = displCtrlObj.Global
	dispCtrlGlobalObj.UserLayerDisplayLevel(userLayerName) = epcbDisplayLevelTop
	dispCtrlGlobalObj.RaiseUserLayerDisplayLevel(userLayerName)
	displCtrlObj.UserLayer(userLayerName)=True
end sub
